home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / CHKCHR.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  2.8 KB  |  71 lines
  1.       SUBROUTINE CHKCHR 
  2. C Checks that incorrect relational operators
  3. C are not used to compare   
  4. C character strings in IF clauses.  
  5. C INPUT ; current statement description 
  6. C OUTPUT ; NFAULT   
  7. C   
  8.       include 'PARAM.h' 
  9.       include 'ALCAZA.h' 
  10.       include 'CLASS.h' 
  11.       include 'FLAGS.h' 
  12.       include 'CURSTA.h' 
  13.       include 'STATE.h' 
  14.       include 'USSTMT.h' 
  15.       include 'USUNIT.h' 
  16.       include 'USLTYD.h' 
  17.       include 'USIGNO.h' 
  18.       include 'CHECKS.h' 
  19.       LOGICAL BTEST 
  20.       IF(UNFLP) RETURN  
  21.       IF(.NOT.LCHECK(42)) RETURN
  22.       ICL1 = ICURCL(1)  
  23.       IF(.NOT.LIFF(ICL1)) RETURN
  24. C Find end of IF
  25.       ILOC = INDEX(SSTA(:NCHST),'(')
  26.       IF(ILOC.EQ.0)  RETURN 
  27.       CALL SKIPLV(SSTA,ILOC+1,NCHST,.FALSE.,ILOCE,ILEV) 
  28.       IF(ILOCE.EQ.0) RETURN 
  29.       DO 40 I=1,NSNAME  
  30. C Looping over variable names in the statement  
  31.          IF(NSSTRT(I).GT.ILOCE) RETURN  
  32. C Variable is inside IF clause  
  33.          IF(.NOT.BTEST(NAMTYP(ISNAME+I),5))                      GOTO 40
  34. C Character variable
  35.          DO 10 IPOS=NSSTRT(I)-1,ILOC+1,-1   
  36.             IF(SSTA(IPOS:IPOS).EQ.' ')                           GOTO 10
  37.             IF(SSTA(IPOS:IPOS).EQ.'(')                           GOTO 20
  38.             IF(SSTA(IPOS:IPOS).NE.'.')                           GOTO 20
  39. C Check for incorrect relational operators  
  40.             IF(SSTA(IPOS-3:IPOS).EQ.'.OR.')                      GOTO 20
  41.             IF(SSTA(IPOS-3:IPOS).EQ.'.EQ.')                      GOTO 20
  42.             IF(SSTA(IPOS-3:IPOS).EQ.'.NE.')                      GOTO 20
  43.             IF(SSTA(IPOS-4:IPOS).EQ.'.AND.')                     GOTO 20
  44.             IF(ILOCE-ILOC.GT.20) ILOCE=ILOC+20  
  45.             WRITE(MZUNIT,500) SSTA(ILOC:ILOCE)  
  46.             NFAULT = NFAULT + 1 
  47.             RETURN  
  48.    10    CONTINUE   
  49.    20    ILEV = 0   
  50.          DO 30 IPOS=NSEND(I)+1,ILOCE-1  
  51.             IF(SSTA(IPOS:IPOS).EQ.' ')                           GOTO 30
  52.             IF(SSTA(IPOS:IPOS).EQ.'(') ILEV=ILEV+1  
  53.             IF(SSTA(IPOS:IPOS).EQ.')') ILEV=ILEV-1  
  54.             IF(SSTA(IPOS:IPOS).EQ.')')                           GOTO 30
  55.             IF(ILEV.NE.0)                                        GOTO 30
  56.             IF(SSTA(IPOS:IPOS).NE.'.')                           GOTO 40
  57.             IF(SSTA(IPOS:IPOS+3).EQ.'.OR.')                      GOTO 40
  58.             IF(SSTA(IPOS:IPOS+3).EQ.'.EQ.')                      GOTO 40
  59.             IF(SSTA(IPOS:IPOS+3).EQ.'.NE.')                      GOTO 40
  60.             IF(SSTA(IPOS:IPOS+4).EQ.'.AND.')                     GOTO 40
  61.             IF(ILOCE-ILOC.GT.20) ILOCE=ILOC+20  
  62.             WRITE(MZUNIT,500) SSTA(ILOC:ILOCE)  
  63.             NFAULT = NFAULT + 1 
  64.             RETURN  
  65.    30    CONTINUE   
  66.    40 CONTINUE  
  67.       RETURN
  68.   500 FORMAT(1X,'!!! WARNING ... IF CLAUSE ',A,' USES', 
  69.      +' INCORRECT RELATIONAL OPERATORS FOR CHARACTER TYPE') 
  70.       END   
  71.